home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / dev / lang / sofa.lha / sofa / smalleiffel / contrib / edb / edb.el < prev    next >
Lisp/Scheme  |  2000-03-25  |  34KB  |  1,009 lines
  1. ;;; edb.el --- run edb under Emacs
  2. ;; ======================================================================
  3. ;; SmallEiffel debugger on GDB.
  4. ;;
  5. ;;  Aug 28 1997 M.Mogaki
  6. ;;            mmogaki@kanagawa.hitachi.co.jp
  7. ;;
  8. ;;  print local variable and class attribute with `p' comand.
  9. ;;
  10. ;;; Alogorithm outline.
  11. ;;   1)  if command like "p x" is typed,
  12. ;;       try command "p _x" and "p C._x" to obtain reasonable printing.
  13. ;;   2)  If it is a pointer to some object, gdb will prints as follows.
  14. ;;         $1 = (T0 *) 0x40000000
  15. ;;   3) Try command "p *$1" to obtain class id of this.
  16. ;;        Gdb will print as follows.
  17. ;;         $2 = {id = 7 }
  18. ;;   4) Now we can try comand "p *(T7*)$1" to obtain desired printing
  19. ;;         $3 = {id = 7 , _count = 5, _capacity = 7, _strage = 0x40000016 "STRING" }
  20. ;;   5) In case of dot notation like x.count,
  21. ;;        split them into word like (x count).
  22. ;;        apply 1~3 to obtain the class id of x.
  23. ;;        Once class of x is known, we can try command 
  24. ;;        "p ((T7*)$3)._count"
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26. ;;
  27. ;; Modified from gdb.el         
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;        
  29.  
  30. ;; Author: W. Schelter, University of Texas
  31. ;;     wfs@rascal.ics.utexas.edu
  32. ;; Rewritten by rms.
  33. ;; Keywords: c, unix, tools, debugging
  34.  
  35. ;; Some ideas are due to Masanobu.
  36.  
  37. ;; This file is part of XEmacs.
  38.  
  39. ;; XEmacs is free software; you can redistribute it and/or modify it
  40. ;; under the terms of the GNU General Public License as published by
  41. ;; the Free Software Foundation; either version 2, or (at your option)
  42. ;; any later version.
  43.  
  44. ;; XEmacs is distributed in the hope that it will be useful, but
  45. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  46. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  47. ;; General Public License for more details.
  48.  
  49. ;; You should have received a copy of the GNU General Public License
  50. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  51. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  52. ;; 02111-1307, USA.
  53.  
  54. ;;; Synched up with: Not in FSF
  55.  
  56. ;;; Commentary:
  57.  
  58. ;; Description of EDB interface:
  59.  
  60. ;; A facility is provided for the simultaneous display of the source code
  61. ;; in one window, while using edb to step through a function in the
  62. ;; other.  A small arrow in the source window, indicates the current
  63. ;; line.
  64.  
  65. ;; Starting up:
  66.  
  67. ;; In order to use this facility, invoke the command EDB to obtain a
  68. ;; shell window with the appropriate command bindings.  You will be asked
  69. ;; for the name of a file to run.  Edb will be invoked on this file, in a
  70. ;; window named *edb-foo* if the file is foo.
  71.  
  72. ;; M-s steps by one line, and redisplays the source file and line.
  73.  
  74. ;; You may easily create additional commands and bindings to interact
  75. ;; with the display.  For example to put the edb command next on \M-n
  76. ;; (def-edb next "\M-n")
  77.  
  78. ;; This causes the emacs command edb-next to be defined, and runs
  79. ;; edb-display-frame after the command.
  80.  
  81. ;; edb-display-frame is the basic display function.  It tries to display
  82. ;; in the other window, the file and line corresponding to the current
  83. ;; position in the edb window.  For example after a edb-step, it would
  84. ;; display the line corresponding to the position for the last step.  Or
  85. ;; if you have done a backtrace in the edb buffer, and move the cursor
  86. ;; into one of the frames, it would display the position corresponding to
  87. ;; that frame.
  88.  
  89. ;; edb-display-frame is invoked automatically when a filename-and-line-number
  90. ;; appears in the output.
  91.  
  92. ;;; Code:
  93.  
  94. (require 'comint)
  95. (require 'shell)
  96.  
  97. (condition-case nil
  98.     (if (featurep 'toolbar)
  99.     (require 'eos-toolbar "sun-eos-toolbar"))
  100.   (error nil))
  101.  
  102. (defvar edb-last-frame)
  103. (defvar edb-delete-prompt-marker)
  104. (defvar edb-filter-accumulator)
  105. (defvar edb-last-frame-displayed-p)
  106. (defvar edb-arrow-extent nil)
  107. (or (fboundp 'make-glyph) (fset 'make-glyph 'identity)) ; work w/ pre beta v12
  108. (defvar edb-arrow-glyph (make-glyph "=>"))
  109.  
  110. (make-face 'edb-arrow-face)
  111. (or (face-differs-from-default-p 'edb-arrow-face)
  112.    ;; Usually has a better default value than highlight does
  113.    (copy-face 'isearch 'edb-arrow-face))
  114.  
  115. ;; Hooks can side-effect extent arg to change extent properties
  116. (defvar edb-arrow-extent-hooks '())
  117.  
  118. (defvar edb-prompt-pattern "^>\\|^(.*gdb[+]?) *\\|^---Type <return> to.*--- *"
  119.   "A regexp to recognize the prompt for gdb or gdb+.") 
  120.  
  121. (defvar edb-mode-map nil
  122.   "Keymap for edb-mode.")
  123.  
  124. (defvar edb-toolbar
  125.   '([eos::toolbar-stop-at-icon
  126.      edb-toolbar-break
  127.      t
  128.      "Stop at selected position"]
  129.     [eos::toolbar-stop-in-icon
  130.      edb-toolbar-break
  131.      t
  132.      "Stop in function whose name is selected"]
  133.     [eos::toolbar-clear-at-icon
  134.      edb-toolbar-clear
  135.      t
  136.      "Clear at selected position"]
  137.     [eos::toolbar-evaluate-icon
  138.      nil
  139.      nil
  140.      "Evaluate selected expression; shows in separate XEmacs frame"]
  141.     [eos::toolbar-evaluate-star-icon
  142.      nil
  143.      nil
  144.      "Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
  145.     [eos::toolbar-run-icon
  146.      edb-run
  147.      t
  148.      "Run current program"]
  149.     [eos::toolbar-cont-icon
  150.      edb-cont
  151.      t
  152.      "Continue current program"]
  153.     [eos::toolbar-step-into-icon
  154.      edb-step
  155.      t
  156.      "Step into (aka step)"]
  157.     [eos::toolbar-step-over-icon
  158.      edb-next
  159.      t
  160.      "Step over (aka next)"]
  161.     [eos::toolbar-up-icon
  162.      edb-up
  163.      t
  164.      "Stack Up (towards \"cooler\" - less recently visited - frames)"]
  165.     [eos::toolbar-down-icon
  166.      edb-down
  167.      t
  168.      "Stack Down (towards \"warmer\" - more recently visited - frames)"]
  169.     [eos::toolbar-fix-icon    nil    nil    "Fix (not available with edb)"]
  170.     [eos::toolbar-build-icon
  171.      toolbar-compile
  172.      t
  173.      "Build (aka make -NYI)"]
  174.     ))
  175.  
  176. (if edb-mode-map
  177.    nil
  178.   (setq edb-mode-map (make-sparse-keymap))
  179.   (set-keymap-name edb-mode-map 'edb-mode-map)
  180.   (set-keymap-parents edb-mode-map (list comint-mode-map))
  181.   (define-key edb-mode-map "\C-l" 'edb-refresh)
  182.   (define-key edb-mode-map "\C-c\C-c" 'edb-control-c-subjob)
  183.   (define-key edb-mode-map "\t" 'comint-dynamic-complete)
  184.   (define-key edb-mode-map "\M-?" 'comint-dynamic-list-completions))
  185.  
  186. (define-key ctl-x-map " " 'edb-break)
  187. (define-key ctl-x-map "&" 'send-edb-command)
  188.  
  189. ;;Of course you may use `def-edb' with any other edb command, including
  190. ;;user defined ones.   
  191.  
  192. (defmacro def-edb (name key &optional doc &rest forms)
  193.   (let* ((fun (intern (format "edb-%s" name)))
  194.      (cstr (list 'if '(not (= 1 arg))
  195.              (list 'format "%s %s" name 'arg)
  196.              name)))
  197.     (list 'progn
  198.       (nconc (list 'defun fun '(arg)
  199.                (or doc "")
  200.                '(interactive "p")
  201.                (list 'edb-call cstr))
  202.          forms)
  203.       (and key (list 'define-key 'edb-mode-map key  (list 'quote fun))))))
  204.  
  205. (def-edb "step"   "\M-s" "Step one source line with display"
  206.   (edb-delete-arrow-extent))
  207. (def-edb "stepi"  "\M-i" "Step one instruction with display"
  208.   (edb-delete-arrow-extent))
  209. (def-edb "finish" "\C-c\C-f" "Finish executing current function"
  210.   (edb-delete-arrow-extent))
  211. (def-edb "run" nil "Run the current program"
  212.   (edb-delete-arrow-extent))
  213.  
  214. ;;"next" and "cont" were bound to M-n and M-c in Emacs 18, but these are
  215. ;;poor choices, since M-n is used for history navigation and M-c is
  216. ;;capitalize-word.  These are defined without key bindings so that users
  217. ;;may choose their own bindings.
  218. (def-edb "next"   "\C-c\C-n" "Step one source line (skip functions)"
  219.   (edb-delete-arrow-extent))
  220. (def-edb "cont"   "\C-c\M-c" "Proceed with the program"
  221.   (edb-delete-arrow-extent))
  222.  
  223. (def-edb "up"     "\C-c<" "Go up N stack frames (numeric arg) with display")
  224. (def-edb "down"   "\C-c>" "Go down N stack frames (numeric arg) with display")
  225.  
  226. (defvar edb-display-mode nil
  227.   "Minor mode for edb frame display")
  228. (or (assq 'edb-display-mode minor-mode-alist)
  229.     (setq minor-mode-alist
  230.       (purecopy
  231.        (append minor-mode-alist
  232.            '((edb-display-mode " Frame"))))))
  233.  
  234. (defun edb-display-mode (&optional arg)
  235.   "Toggle EDB Frame display mode
  236. With arg, turn display mode on if and only if arg is positive.
  237. In the display minor mode, source file are displayed in another
  238. window for repective \\[edb-display-frame] commands."
  239.   (interactive "P")
  240.   (setq edb-display-mode (if (null arg)
  241.                  (not edb-display-mode)
  242.                (> (prefix-numeric-value arg) 0))))
  243.  
  244. ;; Using cc-mode's syntax table is broken.
  245. (defvar edb-mode-syntax-table nil
  246.   "Syntax table for EDB mode.")
  247.  
  248. ;; This is adapted from CC Mode 5.11.
  249. (unless edb-mode-syntax-table
  250.   (setq edb-mode-syntax-table (make-syntax-table))
  251.   ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
  252.   (modify-syntax-entry ?_  "_" edb-mode-syntax-table)
  253.   (modify-syntax-entry ?\\ "\\" edb-mode-syntax-table)
  254.   (modify-syntax-entry ?+  "." edb-mode-syntax-table)
  255.   (modify-syntax-entry ?-  "." edb-mode-syntax-table)
  256.   (modify-syntax-entry ?=  "." edb-mode-syntax-table)
  257.   (modify-syntax-entry ?%  "." edb-mode-syntax-table)
  258.   (modify-syntax-entry ?<  "." edb-mode-syntax-table)
  259.   (modify-syntax-entry ?>  "." edb-mode-syntax-table)
  260.   (modify-syntax-entry ?&  "." edb-mode-syntax-table)
  261.   (modify-syntax-entry ?|  "." edb-mode-syntax-table)
  262.   (modify-syntax-entry ?\' "\"" edb-mode-syntax-table)
  263.   ;; add extra comment syntax
  264.   (modify-syntax-entry ?/  ". 14"  edb-mode-syntax-table)
  265.   (modify-syntax-entry ?*  ". 23"  edb-mode-syntax-table))
  266.  
  267.  
  268. (defun edb-mode ()
  269.   "Major mode for interacting with an inferior Edb process.
  270. The following commands are available:
  271.  
  272. \\{edb-mode-map}
  273.  
  274. \\[edb-display-frame] displays in the other window
  275. the last line referred to in the edb buffer. See also
  276. \\[edb-display-mode].
  277.  
  278. \\[edb-step],\\[edb-next], and \\[edb-nexti] in the edb window,
  279. call edb to step,next or nexti and then update the other window
  280. with the current file and position.
  281.  
  282. If you are in a source file, you may select a point to break
  283. at, by doing \\[edb-break].
  284.  
  285. Commands:
  286. Many commands are inherited from comint mode. 
  287. Additionally we have:
  288.  
  289. \\[edb-display-frame] display frames file in other window
  290. \\[edb-step] advance one line in program
  291. \\[send-edb-command] used for special printing of an arg at the current point.
  292. C-x SPACE sets break point at current line."
  293.   (interactive)
  294.   (comint-mode)
  295.   (use-local-map edb-mode-map)
  296.   (set-syntax-table edb-mode-syntax-table)
  297.   (make-local-variable 'edb-last-frame-displayed-p)
  298.   (make-local-variable 'edb-last-frame)
  299.   (make-local-variable 'edb-delete-prompt-marker)
  300.   (make-local-variable 'edb-display-mode)
  301.   (make-local-variable' edb-filter-accumulator)
  302.   (setq edb-last-frame nil
  303.         edb-delete-prompt-marker nil
  304.         edb-filter-accumulator nil
  305.     edb-display-mode t
  306.         major-mode 'edb-mode
  307.         mode-name "Inferior EDB"
  308.         comint-prompt-regexp edb-prompt-pattern
  309.         edb-last-frame-displayed-p t)
  310.   (set (make-local-variable 'shell-dirtrackp) t)
  311.   ;;(make-local-variable 'edb-arrow-extent)
  312.   (and (extentp edb-arrow-extent)
  313.        (delete-extent edb-arrow-extent))
  314.   (setq edb-arrow-extent nil)
  315.   ;; XEmacs change:
  316.   (make-local-hook 'kill-buffer-hook)
  317.   (add-hook 'kill-buffer-hook 'edb-delete-arrow-extent nil t)
  318. ;  (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
  319.   (add-hook 'comint-input-filter-functions 'gud-edb-input-filter nil t)
  320.   (run-hooks 'edb-mode-hook))
  321.  
  322. (defun edb-delete-arrow-extent ()
  323.   (let ((inhibit-quit t))
  324.     (if edb-arrow-extent
  325.         (delete-extent edb-arrow-extent))
  326.     (setq edb-arrow-extent nil)))
  327.  
  328. (defvar current-edb-buffer nil)
  329.  
  330. ;;;###autoload
  331. (defvar edb-command-name "gdb"
  332.   "Pathname for executing edb.")
  333.  
  334. ;;;###autoload
  335. (defun edb (path &optional corefile)
  336.   "Run edb on program FILE in buffer *edb-FILE*.
  337. The directory containing FILE becomes the initial working directory
  338. and source-file directory for EDB.  If you wish to change this, use
  339. the EDB commands `cd DIR' and `directory'."
  340.   (interactive "FRun edb on file: ")
  341.   (setq path (file-truename (expand-file-name path)))
  342.   (let ((file (file-name-nondirectory path)))
  343.     (switch-to-buffer (concat "*edb-" file "*"))
  344.     (setq default-directory (file-name-directory path))
  345.     (or (bolp) (newline))
  346.     (insert "Current directory is " default-directory "\n")
  347.     (apply 'make-comint
  348.        (concat "edb-" file)
  349.        (substitute-in-file-name edb-command-name)
  350.        nil
  351.        "-fullname"
  352.        "-cd" default-directory
  353.        file
  354.        (and corefile (list corefile)))
  355.     (set-process-filter (get-buffer-process (current-buffer)) 'edb-filter)
  356.     (set-process-sentinel (get-buffer-process (current-buffer)) 'edb-sentinel)
  357.     ;; XEmacs change: turn on edb mode after setting up the proc filters
  358.     ;; for the benefit of shell-font.el
  359.     (edb-mode)
  360.     (edb-set-buffer)))
  361.  
  362. ;;;###autoload
  363. (defun edb-with-core (file corefile)
  364.   "Debug a program using a corefile."
  365.   (interactive "fProgram to debug: \nfCore file to use: ")
  366.   (edb file corefile))
  367.  
  368. (defun edb-set-buffer ()
  369.   (cond ((eq major-mode 'edb-mode)
  370.      (setq current-edb-buffer (current-buffer))
  371.      (if (featurep 'eos-toolbar)
  372.          (set-specifier default-toolbar (cons (current-buffer)
  373.                           edb-toolbar))))))
  374.  
  375.  
  376. ;; This function is responsible for inserting output from EDB
  377. ;; into the buffer.
  378. ;; Aside from inserting the text, it notices and deletes
  379. ;; each filename-and-line-number;
  380. ;; that EDB prints to identify the selected frame.
  381. ;; It records the filename and line number, and maybe displays that file.
  382. (defun edb-filter (proc string)
  383.   (let ((inhibit-quit t))
  384.     (save-current-buffer
  385.      (set-buffer (process-buffer proc))
  386.       (if edb-filter-accumulator
  387.       (edb-filter-accumulate-marker
  388.        proc (concat edb-filter-accumulator string))
  389.     (edb-filter-scan-input proc string)))))
  390.  
  391. (defun edb-filter-accumulate-marker (proc string)
  392.   (setq edb-filter-accumulator nil)
  393.   (if (> (length string) 1)
  394.       (if (= (aref string 1) ?\032)
  395.       (let ((end (string-match "\n" string)))
  396.         (if end
  397.         (progn
  398.           (let* ((first-colon (string-match ":" string 2))
  399.              (second-colon
  400.               (string-match ":" string (1+ first-colon))))
  401.             (setq edb-last-frame
  402.               (cons (substring string 2 first-colon)
  403.                 (string-to-int
  404.                  (substring string (1+ first-colon)
  405.                         second-colon)))))
  406.           (setq edb-last-frame-displayed-p nil)
  407.           (edb-filter-scan-input proc
  408.                      (substring string (1+ end))))
  409.           (setq edb-filter-accumulator string)))
  410.     (edb-filter-insert proc "\032")
  411.     (edb-filter-scan-input proc (substring string 1)))
  412.     (setq edb-filter-accumulator string)))
  413.  
  414. (defun edb-filter-scan-input (proc string)
  415.   (if (equal string "")
  416.       (setq edb-filter-accumulator nil)
  417.     (let ((start (string-match "\032" string)))
  418.       (if start
  419.       (progn (edb-filter-insert proc (substring string 0 start))
  420.          (edb-filter-accumulate-marker proc
  421.                            (substring string start)))
  422.     (edb-filter-insert proc
  423.                (gud-edb-output-filter
  424.                string))))))
  425.  
  426. (defun edb-filter-insert (proc string)
  427.   (let ((moving (= (point) (process-mark proc)))
  428.     (output-after-point (< (point) (process-mark proc))))
  429.     (save-excursion
  430.       ;; Insert the text, moving the process-marker.
  431.       (goto-char (process-mark proc))
  432.       (insert-before-markers string)
  433.       (set-marker (process-mark proc) (point))
  434.       (edb-maybe-delete-prompt)
  435.       ;; Check for a filename-and-line number.
  436.       (edb-display-frame
  437.        ;; Don't display the specified file
  438.        ;; unless (1) point is at or after the position where output appears
  439.        ;; and (2) this buffer is on the screen.
  440.        (or output-after-point
  441.            (not (get-buffer-window (current-buffer))))
  442.        ;; Display a file only when a new filename-and-line-number appears.
  443.        t))
  444.     (if moving (goto-char (process-mark proc))))
  445.  
  446.   (let (s)
  447.     (if (and (should-use-dialog-box-p)
  448.          (setq s (or (string-match " (y or n) *\\'" string)
  449.              (string-match " (yes or no) *\\'" string))))
  450.     (edb-mouse-prompt-hack (substring string 0 s) (current-buffer))))
  451.   )
  452.  
  453. (defun edb-mouse-prompt-hack (prompt buffer)
  454.   (popup-dialog-box
  455.    (list prompt
  456.      (vector "Yes"    (list 'edb-mouse-prompt-hack-answer 't   buffer) t)
  457.      (vector "No"     (list 'edb-mouse-prompt-hack-answer 'nil buffer) t)
  458.      nil
  459.      (vector "Cancel" (list 'edb-mouse-prompt-hack-answer 'nil buffer) t)
  460.      )))
  461.  
  462. (defun edb-mouse-prompt-hack-answer (answer buffer)
  463.   (let ((b (current-buffer)))
  464.     (unwind-protect
  465.     (progn
  466.       (set-buffer buffer)
  467.       (goto-char (process-mark (get-buffer-process buffer)))
  468.       (delete-region (point) (point-max))
  469.       (insert (if answer "yes" "no"))
  470.       (comint-send-input))
  471.       (set-buffer b))))
  472.  
  473. (defun edb-sentinel (proc msg)
  474.   (cond ((null (buffer-name (process-buffer proc)))
  475.      ;; buffer killed
  476.      ;; Stop displaying an arrow in a source file.
  477.      ;(setq overlay-arrow-position nil) -- done by kill-buffer-hook
  478.      (set-process-buffer proc nil))
  479.     ((memq (process-status proc) '(signal exit))
  480.      ;; Stop displaying an arrow in a source file.
  481.          (edb-delete-arrow-extent)
  482.      ;; Fix the mode line.
  483.      (setq modeline-process
  484.            (concat ": edb " (symbol-name (process-status proc))))
  485.      (let* ((obuf (current-buffer)))
  486.        ;; save-excursion isn't the right thing if
  487.        ;;  process-buffer is current-buffer
  488.        (unwind-protect
  489.            (progn
  490.          ;; Write something in *compilation* and hack its mode line,
  491.          (set-buffer (process-buffer proc))
  492.          ;; Force mode line redisplay soon
  493.          (set-buffer-modified-p (buffer-modified-p))
  494.          (if (eobp)
  495.              (insert ?\n mode-name " " msg)
  496.            (save-excursion
  497.              (goto-char (point-max))
  498.              (insert ?\n mode-name " " msg)))
  499.          ;; If buffer and mode line will show that the process
  500.          ;; is dead, we can delete it now.  Otherwise it
  501.          ;; will stay around until M-x list-processes.
  502.          (delete-process proc))
  503.          ;; Restore old buffer, but don't restore old point
  504.          ;; if obuf is the edb buffer.
  505.          (set-buffer obuf))))))
  506.  
  507.  
  508. (defun edb-refresh (&optional arg)
  509.   "Fix up a possibly garbled display, and redraw the arrow."
  510.   (interactive "P")
  511.   (recenter arg)
  512.   (edb-display-frame))
  513.  
  514. (defun edb-display-frame (&optional nodisplay noauto)
  515.   "Find, obey and delete the last filename-and-line marker from EDB.
  516. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
  517. Obeying it means displaying in another window the specified file and line."
  518.   (interactive)
  519.   (edb-set-buffer)
  520.   (and edb-last-frame (not nodisplay)
  521.        edb-display-mode
  522.        (or (not edb-last-frame-displayed-p) (not noauto))
  523.        (progn (edb-display-line (car edb-last-frame) (cdr edb-last-frame))
  524.           (setq edb-last-frame-displayed-p t))))
  525.  
  526. ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
  527. ;; and that its line LINE is visible.
  528. ;; Put the overlay-arrow on the line LINE in that buffer.
  529.  
  530. (defun edb-display-line (true-file line &optional select-method)
  531.   ;; FILE to display
  532.   ;; LINE number to highlight and make visible
  533.   ;; SELECT-METHOD 'source, 'debugger, or 'none.  (default is 'debugger)
  534.   (and (null select-method) (setq select-method 'debugger))
  535.   (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
  536.      (pop-up-windows t)
  537.      (source-buffer (find-file-noselect true-file))
  538.      (source-window (display-buffer source-buffer))
  539.      (debugger-window (get-buffer-window current-edb-buffer))
  540.          (extent edb-arrow-extent)
  541.      pos)
  542.     ;; XEmacs change: make sure we find a window displaying the source file
  543.     ;; even if we are already sitting in it when a breakpoint is hit.
  544.     ;; Otherwise the t argument to display-buffer will prevent it from being
  545.     ;; displayed.
  546.     (save-excursion 
  547.       (cond ((eq select-method 'debugger)
  548.          ;; might not already be displayed
  549.          (setq debugger-window (display-buffer current-edb-buffer))
  550.          (select-window debugger-window))
  551.         ((eq select-method 'source)
  552.          (select-window source-window))))
  553.     (and extent
  554.      (not (eq (extent-object extent) source-buffer))
  555.      (setq extent (delete-extent extent)))
  556.     (or extent
  557.         (progn
  558.           (setq extent (make-extent 1 1 source-buffer))
  559.           (set-extent-face extent 'edb-arrow-face)
  560.       (set-extent-begin-glyph extent edb-arrow-glyph)
  561.           (set-extent-begin-glyph-layout extent 'whitespace)
  562.           (set-extent-priority extent 2000)
  563.           (setq edb-arrow-extent extent)))
  564.     (save-current-buffer
  565.       (set-buffer source-buffer)
  566.       (save-restriction
  567.     (widen)
  568.     (goto-line line)
  569.     (set-window-point source-window (point))
  570.     (setq pos (point))
  571.         (end-of-line)
  572.         (set-extent-endpoints extent pos (point))
  573.         (run-hook-with-args 'edb-arrow-extent-hooks extent))
  574.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  575.          (widen)
  576.          (goto-char pos))))
  577.     ;; Added by Stig.  It caused lots of problems for several users
  578.     ;; and since its purpose is unclear it is getting commented out.
  579.     ;;(and debugger-window
  580.     ;; (set-window-point debugger-window pos))
  581.     ))
  582.  
  583. (defun edb-call (command)
  584.   "Invoke edb COMMAND displaying source in other window."
  585.   (interactive)
  586.   (goto-char (point-max))
  587.   ;; Record info on the last prompt in the buffer and its position.
  588.   ;; This is used in  edb-maybe-delete-prompt
  589.   ;; to prevent multiple prompts from accumulating.
  590.   (save-excursion
  591.     (goto-char (process-mark (get-buffer-process current-edb-buffer)))
  592.     (let ((pt (point)))
  593.       (beginning-of-line)
  594.       (setq edb-delete-prompt-marker
  595.         (if (= (point) pt)
  596.         nil
  597.           (list (point-marker) (- pt (point))
  598.             (buffer-substring (point) pt))))))
  599.   (edb-set-buffer)
  600.   (process-send-string (get-buffer-process current-edb-buffer)
  601.            (concat command "\n")))
  602.  
  603. (defun edb-maybe-delete-prompt ()
  604.   (if edb-delete-prompt-marker
  605.       ;; Get the string that we used as the prompt before.
  606.       (let ((prompt (nth 2 edb-delete-prompt-marker))
  607.         (length (nth 1 edb-delete-prompt-marker)))
  608.     ;; Position after it.
  609.     (goto-char (+ (car edb-delete-prompt-marker) length))
  610.     ;; Delete any duplicates of it which follow right after.
  611.     (while (and (<= (+ (point) length) (point-max))
  612.             (string= prompt
  613.                  (buffer-substring (point) (+ (point) length))))
  614.       (delete-region (point) (+ (point) length)))
  615.     ;; If that didn't take us to where output is arriving,
  616.     ;; we have encountered something other than a prompt,
  617.     ;; so stop trying to delete any more prompts.
  618.     (if (not (= (point)
  619.             (process-mark (get-buffer-process current-edb-buffer))))
  620.         (progn
  621.           (set-marker (car edb-delete-prompt-marker) nil)
  622.           (setq edb-delete-prompt-marker nil))))))
  623.  
  624. (defun edb-break (temp)
  625.   "Set EDB breakpoint at this source line.  With ARG set temporary breakpoint."
  626.   (interactive "P")
  627.   (let* ((file-name (file-name-nondirectory buffer-file-name))
  628.      (line (save-restriction
  629.          (widen)
  630.          (beginning-of-line)
  631.          (1+ (count-lines 1 (point)))))
  632.      (cmd (concat (if temp "tbreak " "break ") file-name ":"
  633.               (int-to-string line))))
  634.     (set-buffer current-edb-buffer)
  635.     (goto-char (process-mark (get-buffer-process current-edb-buffer)))
  636.     (delete-region (point) (point-max))
  637.     (insert cmd)
  638.     (comint-send-input)
  639.     ;;(process-send-string (get-buffer-process current-edb-buffer) cmd)
  640.     ))
  641.  
  642. (defun edb-clear ()
  643.   "Set EDB breakpoint at this source line."
  644.   (interactive)
  645.   (let* ((file-name (file-name-nondirectory buffer-file-name))
  646.      (line (save-restriction
  647.          (widen)
  648.          (beginning-of-line)
  649.          (1+ (count-lines 1 (point)))))
  650.      (cmd (concat "clear " file-name ":"
  651.               (int-to-string line))))
  652.     (set-buffer current-edb-buffer)
  653.     (goto-char (process-mark (get-buffer-process current-edb-buffer)))
  654.     (delete-region (point) (point-max))
  655.     (insert cmd)
  656.     (comint-send-input)
  657.     ;;(process-send-string (get-buffer-process current-edb-buffer) cmd)
  658.     ))
  659.  
  660. (defun edb-read-address()
  661.   "Return a string containing the core-address found in the buffer at point."
  662.   (save-excursion
  663.    (let ((pt (point)) found begin)
  664.      (setq found (if (search-backward "0x" (- pt 7) t)(point)))
  665.      (cond (found (forward-char 2)
  666.           (buffer-substring found
  667.                     (progn (re-search-forward "[^0-9a-f]")
  668.                        (forward-char -1)
  669.                        (point))))
  670.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  671.                  (point)))
  672.           (forward-char 1)
  673.           (re-search-forward "[^0-9]")
  674.           (forward-char -1)
  675.           (buffer-substring begin (point)))))))
  676.  
  677.  
  678. (defvar edb-commands nil
  679.   "List of strings or functions used by send-edb-command.
  680. It is for customization by you.")
  681.  
  682. (defun send-edb-command (arg)
  683.  
  684.   "This command reads the number where the cursor is positioned.  It
  685.  then inserts this ADDR at the end of the edb buffer.  A numeric arg
  686.  selects the ARG'th member COMMAND of the list edb-print-command.  If
  687.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  688.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  689.  is a possible string to be a member of edb-commands.  "
  690.  
  691.  
  692.   (interactive "P")
  693.   (let (comm addr)
  694.     (if arg (setq comm (nth arg edb-commands)))
  695.     (setq addr (edb-read-address))
  696.     (if (eq (current-buffer) current-edb-buffer)
  697.     (set-mark (point)))
  698.     (cond (comm
  699.        (setq comm
  700.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  701.       (t (setq comm addr)))
  702.     (switch-to-buffer current-edb-buffer)
  703.     (goto-char (point-max))
  704.     (insert comm)))
  705.  
  706. (fset 'edb-control-c-subjob 'comint-interrupt-subjob)
  707.  
  708. ;(defun edb-control-c-subjob ()
  709. ;  "Send a Control-C to the subprocess."
  710. ;  (interactive)
  711. ;  (process-send-string (get-buffer-process (current-buffer))
  712. ;               "\C-c"))
  713.  
  714. (defun edb-toolbar-break ()
  715.   (interactive)
  716.   (save-excursion
  717.     (message (car edb-last-frame))
  718.     (set-buffer (find-file-noselect (car edb-last-frame)))
  719.     (edb-break nil)))
  720.  
  721. (defun edb-toolbar-clear ()
  722.   (interactive)
  723.   (save-excursion
  724.     (message (car edb-last-frame))
  725.     (set-buffer (find-file-noselect (car edb-last-frame)))
  726.     (edb-clear)))
  727.  
  728.  
  729.  
  730. (defvar edb-query-state nil)
  731.  
  732. (defvar edb-print-var-orig nil)
  733. (defvar edb-print-var-seq nil)
  734. (defvar edb-last-print-var nil)
  735. (defvar edb-print-var nil)
  736. (defvar edb-print-var-seq nil)
  737. (defvar edb-target-var nil)
  738. (defvar edb-target-cid nil)
  739.  
  740. (defun matched-string (str at)
  741.   (substring str (match-beginning at) (match-end at)))
  742.  
  743. ;;
  744. ;;  User input: p x.y
  745. ;;                              (sate,target,var,rest)    command
  746. ;;  (INIT,"",x,(y))
  747. ;;     when No symbol "x" in current context
  748. ;;      --> is it local var?         --> (LOCAL,"",x,(y))    p _x
  749. ;;     when Threre is no member named ...
  750. ;;      --> check type of x         --> (TYPE,x,y,())    p *(T0*)x
  751. ;;     when $x = (Txx*)0x40....
  752. ;;      --> reference            --> (TYPE,$x,"",())    p *(T0*)$x
  753. ;;     when $x = Something else
  754. ;;      --> Result.            --> (nil,x.y,*)        ""
  755. ;;
  756. ;;  (LOCAL,"",x,(y)) p _x
  757. ;;     when No symbol "_x" in current context
  758. ;;      --> try C._x            --> (ATTR,"",x,(y))    p C._x
  759. ;;     when $x = (Txx*)0x40....
  760. ;;      --> known type reference    --> (TYPE,$x,x,(y))    p *(T0*)$x
  761. ;;     when $x = Something else
  762. ;;      --> Result.            --> (nil)        ""
  763. ;;
  764. ;;  (ATTR,"",x,(y))
  765. ;;     when Threre is no member named ...
  766. ;;      --> try feature call of Current --> (CTYPE,"C",x,(y))    p "*C"
  767. ;;     when $x = (Txx*)0x40......
  768. ;;      --> known type reference    --> (TYPE,$x,x,(y))    p *(T0*)$x
  769. ;;     when $x = Something else
  770. ;;      --> Result.            --> (nil)        ""
  771. ;;
  772. ;;  (CTYPE)
  773. ;;     when $1 = {id=???}
  774. ;;;    --> try feature call of target -->(FCALL,$x,x,(y))    p rT???x($x)
  775. ;;     othewise
  776. ;;
  777. ;;  (FCALL)
  778. ;;     when $x = (Txx*)0x40......
  779. ;;      --> known type reference    --> (TYPE,$x,x,(y))    p *(T0*)$x
  780. ;;     when $x = Something else
  781. ;;      --> Result.            --> (nil)        ""
  782. ;;
  783. ;;  (TYPE) p *(T0*)$x
  784. ;;      when $y = {$id=???}
  785. ;;        if more quorifier        -->(VALUE,$x,y,())    p ((Txx*)$x)._y
  786. ;;        if no more quorifier        -->(VALUE,$x,x,())    p *(Txx*)$x
  787. ;;
  788. ;;  (VALUE)
  789. ;;     when Threre is no member named ...
  790. ;;      --> try feature call        --> (FCALL,$x,x,(y))    p r???x($x)
  791. ;;     when $x = (Txx*)0x40......
  792. ;;      --> known type reference    --> (TYPE,$x,x,(y))    p *(T0*)$x
  793. ;;     when $x = Something else
  794. ;;      --> Result.            --> (nil)        ""
  795. ;;
  796.  
  797. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  798. ;;
  799. ;; edb filter
  800. ;;
  801. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  802.  
  803. (defun gud-edb-input-filter (input)
  804.   (when (and (null edb-query-state)
  805.          (string-match "p +\\([$A-Za-z_][.0-9A-Z_a-z]*\\)$" input))
  806.     (message-s "input-filter <-- [%s]" input)
  807.     (setq edb-print-var-orig (matched-string input 1))
  808.     (setq edb-print-var-seq (reverse (split-string-at-dot edb-print-var-orig)))
  809.     (setq edb-last-print-var nil)
  810.     (setq edb-print-var (car edb-print-var-seq))
  811.     (setq edb-print-var-seq (cdr edb-print-var-seq))
  812.     (setq edb-target-var nil)
  813.     (setq edb-target-cid nil)
  814.     (setq edb-query-state 'INIT)
  815.     ))
  816.  
  817. (defun split-string-at-dot (str)
  818.   (let ((s nil)
  819.     (res nil))
  820.     (while (string-match "\\([^.]*\\)\\." str)
  821.       (setq s (matched-string str 1))
  822.       (setq res (cons s res))
  823.       (setq str (substring str (+ 1 (match-end 1)))))
  824.     (cons str res)
  825. ))
  826.  
  827.  
  828. (defvar last_str "")
  829.  
  830. (defun gud-edb-output-filter (str)
  831.   (message-s "output-filter --> [%s]" str)
  832.   (if edb-query-state
  833.       (gud-edb-print-filter (concat last_str str))
  834.     str))
  835.  
  836. (defun gud-edb-print-filter (str)
  837.     (setq last_str "")
  838.     (cond 
  839.      ((string-match "\n" str)
  840.       (setq str (gud-edb-print-filter-switch str)))
  841.      (t (setq last_str str) (setq str "")))
  842.     str)
  843.  
  844. (defun gud-edb-print-filter-switch (str)
  845.   (message-s "print-sw(%s %s %s) <-- [%s]" edb-query-state edb-print-var edb-print-var-seq str)
  846.   (let ((proc (get-buffer-process current-edb-buffer))
  847.     (new-query
  848.      (cond
  849.       ((eq 'INIT edb-query-state)
  850.        (gud-edb-print-filter-INIT str))
  851.       ((eq 'LOCAL edb-query-state)
  852.        (gud-edb-print-filter-LOCAL str))
  853.       ((eq 'ATTR edb-query-state)
  854.        (gud-edb-print-filter-ATTR str))
  855.       ((eq 'CTYPE edb-query-state)
  856.        (gud-edb-print-filter-CTYPE str))
  857.       ((eq 'FCALL edb-query-state)
  858.        (gud-edb-print-filter-FCALL str))
  859.       ((eq 'TYPE edb-query-state)
  860.        (gud-edb-print-filter-TYPE str))
  861.       ((eq 'VALUE edb-query-state)
  862.        (gud-edb-print-filter-VALUE str))
  863.       (t nil))))
  864.  
  865.     (cond (new-query
  866.         (edb-send proc (concat "p " new-query "\n")))
  867.       ((and edb-target-var (string-match "\\$[0-9]*\\( = {id = [0-9]+, .*\\)" str))
  868.        (concat edb-target-var (substring str (match-beginning 1))))
  869.       (t str))))
  870.  
  871.       
  872. (defun gud-edb-print-filter-INIT (str)    
  873.   (cond ((string-match "No symbol \"\\(.*\\)\" in current context\." str)
  874.      (setq edb-query-state 'LOCAL)
  875.      (concat "_" edb-print-var)
  876.      )
  877.     ((string-match "There is no member named" str)
  878.      (setq edb-query-state 'TYPE)
  879.      (setq edb-target-var edb-print-var)
  880.      ;(setq edb-print-var (car edb-print-var-seq))
  881.      ;(setq edb-print-var-seq (cdr edb-print-var-seq))
  882.      (concat "*(T0*)" edb-target-var)
  883.      )
  884.     ((string-match "\\(\\$[0-9]*\\) = (T\\([0-9]*\\) \\*) 0x[0-9a-f]*" str)
  885.      (setq edb-query-state 'TYPE)
  886.      (setq edb-target-var (matched-string str 1))
  887.      (setq edb-target-type (matched-string str 2))
  888.      (setq edb-print-var "")
  889.      (setq edb-print-var-seq nil)
  890.      (concat "*(T" edb-target-type "*)"  edb-target-var)
  891.      )
  892.     (t (setq edb-target-var nil)
  893.        (setq edb-query-state nil)
  894.        
  895.     )))
  896.  
  897. (defun gud-edb-print-filter-LOCAL (str)    
  898.   (cond ((string-match "No symbol \".*\" in current context\." str)
  899.      (setq edb-query-state 'ATTR)
  900.      (concat "C._" edb-print-var))
  901.     ((string-match "\\(\\$[0-9]*\\) = (T\\([0-9]*\\) \\*) 0x[0-9a-f]*" str)
  902.      (setq edb-query-state 'TYPE)
  903.      (setq edb-target-var (matched-string str 1))
  904.      (setq edb-target-type (matched-string str 2))
  905.      (concat "*(T" edb-target-type "*)" edb-target-var)
  906.      )
  907.     (t (setq edb-query-state nil)
  908.     )
  909.   ))
  910.  
  911. (defun gud-edb-print-filter-ATTR (str)    
  912.   (cond 
  913.     ((string-match "There is no member named \\(.*\\)" str)
  914.      (setq edb-query-state 'CTYPE)
  915.      "*(T0*)C"
  916.      )
  917.     ((string-match "\\(\\$[0-9]*\\) = (T\\([0-9]*\\) \\*) 0x[0-9a-f]*" str)
  918.      (setq edb-query-state 'TYPE)
  919.      (setq edb-target-var (matched-string str 1))
  920.      (setq edb-target-type (matched-string str 2))
  921.      (concat "*(T" edb-target-type "*)" edb-target-var)
  922.      )
  923.     (t (setq edb-query-state nil)
  924.        )
  925.     )
  926.   )
  927.  
  928.  
  929. (defun gud-edb-print-filter-CTYPE (str)    
  930.   (cond ((string-match "{id = \\([0-9]+\\)" str)
  931.      (setq edb-query-state 'FCALL)
  932.      (setq edb-target-cid (matched-string str 1))
  933.      (concat "r" edb-target-cid edb-print-var "(" edb-target-var ")")
  934.      )
  935.     (t (setq edb-query-state nil)
  936.     )
  937.   ))
  938.  
  939.  
  940. (defun gud-edb-print-filter-FCALL (str)    
  941.   (cond 
  942.     ((string-match "\\(\\$[0-9]*\\) = (T\\([0-9]*\\) \\*) 0x[0-9a-f]*" str)
  943.      (setq edb-query-state 'TYPE)
  944.      (setq edb-target-var (matched-string str 1))
  945.      (setq edb-target-type (matched-string str 2))
  946.      (concat "*(T" edb-target-type "*)" edb-target-var)
  947.      )
  948.     (t (setq edb-query-state nil)
  949.        )
  950.     )
  951.   )
  952.  
  953.  
  954. (defun gud-edb-print-filter-TYPE (str)    
  955.   (cond    ((string-match "{id = \\([0-9]+\\)}" str)
  956.      (setq edb-target-cid (matched-string str 1))
  957.      (cond (edb-print-var-seq
  958.         (setq edb-query-state 'VALUE)
  959.         (setq edb-print-var (car edb-print-var-seq))
  960.         (setq edb-print-var-seq (cdr edb-print-var-seq))
  961.         (concat "((T" edb-target-cid "*)" edb-target-var ")._" edb-print-var)
  962.         )
  963.            (t
  964.         (setq edb-query-state 'VALUE)
  965.         (concat "*(T"  edb-target-cid "*)" edb-target-var)
  966.         )))
  967.     (t (setq edb-query-state nil))
  968.  
  969.     ))
  970.  
  971. (defun gud-edb-print-filter-VALUE (str)    
  972.   (cond 
  973.     ((string-match "There is no member named \\(.*\\)" str)
  974.      (setq edb-query-state 'FCALL)
  975.      (concat "r" edb-target-cid edb-print-var "(" edb-target-var ")") 
  976.      )
  977.     ((string-match "\\(\\$[0-9]*\\) = (T\\([0-9]*\\) \\*) 0x[0-9a-f]*" str)
  978.      (setq edb-query-state 'TYPE)
  979.      (setq edb-target-var (matched-string str 1))
  980.      (setq edb-target-type (matched-string str 2))
  981.      (concat "*(T" edb-target-type "*)" edb-target-var)
  982.      )
  983.     (t (setq edb-query-state nil)
  984.        )
  985.     )
  986.   )
  987.  
  988. (defun edb-send (proc str)
  989.   (message-s "send --> [%s]" str)
  990.   (process-send-string proc str)
  991.   ""
  992.   )
  993.  
  994. (defvar debug-edb nil)
  995.  
  996. (defun message-s (fmt &rest args)
  997.   (if debug-edb
  998.       (save-current-buffer
  999.     (set-buffer "*scratch*")
  1000.     (let ((str (apply 'format fmt args)))
  1001.       (insert str)
  1002.       (insert "\n")
  1003.       str))))
  1004.  
  1005.  
  1006. (provide 'edb)
  1007.  
  1008. ;;; edb.el ends here
  1009.